Buscando la función Constante por partes
La idea es encontrar una función constante por partes donde:
library(dplyr)
library(ggplot2)
library(polynom)
library(splines)
library(plotly)
setwd("C:/hcgalvan/Repositorios/hcgalvan_project/data/union/End")
temp = gsub(".*target.*", "", readLines("dbcasespieceswice.csv"))
data<-read.table(text=temp, sep=",", header=TRUE)
dz<-data.frame(data[,c("D","A","zscore","subclass")])
pcwstd<-data.frame(dz)
pcwstd
###########Posible FORMA 1 Cuando buscamos alguna división mÔs de knots###########
h<-as.numeric(unlist(pcwstd$zscore))
lmax <- h[c(1, which(diff(sign(diff(h)))==-2)+1, length(h))]
order(h, decreasing = FALSE)
dataord <- h[order(h, decreasing = FALSE)]
#plot(dataord)
#####################################
splineKnots.default <- function(object) attr(object, "knots")
splineKnots(bs(dataord,degree=1, df = 5))
#####################################
https://rstudio-pubs-static.s3.amazonaws.com/888881_32c0a14da1e440e7ad9b6f1893fc26fd.html
https://joshua-nugent.github.io/splines/
######################################
# FORMA 2 - QUANTIL 1
#####################################
muestra1<-as.numeric(unlist(dplyr::select(dplyr::filter(pcwstd, subclass == 1,),"zscore")))
poly.calc(sujetos, muestra1)
-6.122264 + 17.67111*x - 18.56562*x^2 + 10.44433*x^3 - 3.536183*x^4 + 0.7576271*x^5 - 0.1036324*x^6 +
0.008774759*x^7 - 0.000418757*x^8 + 8.6019e-06*x^9
sujetos <- c(1:length(muestra1))
sujetos_seq <- seq(from=1, to=10, by=0.1)
pol_muestra1 <- as.function(poly.calc(sujetos, muestra1))
muestra_seq <- pol_muestra1(sujetos_seq)
graf_2 <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+
geom_hline(yintercept = 0, linetype="dashed")+
#Muestra 1
geom_line(aes(x=sujetos_seq, y=muestra_seq), color="green", size=1)+
geom_point(aes(x=sujetos, y=muestra1), color="dodgerblue3", size=3)+
labs(x="sujetos", y="Peso Muestra", title="Interpolación 2, inciso a)")+
theme_bw()
ggplotly(graf_2)
######################################
# FORMA 2 - QUANTIL 2
#####################################
muestra2<-as.numeric(unlist(dplyr::select(dplyr::filter(pcwstd, subclass == 2,),"zscore")))
sujetos2 <- c(1:length(muestra2))
sujetos_seq2 <- seq(from=1, to=10, by=0.1)
pol_muestra2 <- as.function(poly.calc(sujetos2, muestra2))
muestra_seq2 <- pol_muestra2(sujetos_seq2)
poly.calc(sujetos2, muestra2)
-0.2197296 + 2.0046*x - 1.811326*x^2 + 0.8375173*x^3 - 0.2182443*x^4 + 0.03246031*x^5 - 0.002569767*x^6 +
8.38559e-05*x^7
graf_2 <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+
geom_hline(yintercept = 0, linetype="dashed")+
#Muestra 1
geom_line(aes(x=sujetos_seq2, y=muestra_seq2), color="green", size=1)+
geom_point(aes(x=sujetos2, y=muestra2), color="dodgerblue3", size=3)+
labs(x="sujetos", y="Peso Muestra", title="Interpolación 2, inciso a)")+
theme_bw()
ggplotly(graf_2)
######################################
# FORMA 2 - QUANTIL 3
#####################################
muestra3<-as.numeric(unlist(dplyr::select(dplyr::filter(pcwstd, subclass == 3,),"zscore")))
sujetos3 <- c(1:length(muestra3))
sujetos_seq3 <- seq(from=1, to=12, by=0.1)
pol_muestra3 <- as.function(poly.calc(sujetos3, muestra3))
muestra_seq3 <- pol_muestra3(sujetos_seq3)
poly.calc(sujetos3, muestra3)
4.793893 - 11.81498*x + 14.1384*x^2 - 9.532235*x^3 + 4.068752*x^4 - 1.159912*x^5 + 0.2257844*x^6 -
0.03004852*x^7 + 0.002683565*x^8 - 0.0001534813*x^9 + 5.071574e-06*x^10 - 7.35409e-08*x^11
graf_2 <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+
geom_hline(yintercept = 0, linetype="dashed")+
#Muestra 1
geom_line(aes(x=sujetos_seq3, y=muestra_seq3), color="green", size=1)+
geom_point(aes(x=sujetos3, y=muestra3), color="dodgerblue3", size=3)+
labs(x="sujetos", y="Peso Muestra", title="Interpolación 2, inciso a)")+
theme_bw()
ggplotly(graf_2)
######################################
# FORMA 2 - QUANTIL 4
#####################################
muestra4<-as.numeric(unlist(dplyr::select(dplyr::filter(pcwstd, subclass == 4,),"zscore")))
sujetos4 <- c(1:length(muestra4))
sujetos_seq4 <- seq(from=1, to=8, by=0.1)
pol_muestra4 <- as.function(poly.calc(sujetos4, muestra4))
muestra_seq4 <- pol_muestra4(sujetos_seq4)
poly.calc(sujetos4, muestra4)
2.512275 - 4.393058*x + 4.022133*x^2 - 1.838199*x^3 + 0.4632213*x^4 - 0.06537888*x^5 + 0.004842031*x^6 -
0.0001464992*x^7
graf_2 <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+
geom_hline(yintercept = 0, linetype="dashed")+
#Muestra 1
geom_line(aes(x=sujetos_seq4, y=muestra_seq4), color="green", size=1)+
geom_point(aes(x=sujetos4, y=muestra4), color="dodgerblue3", size=3)+
labs(x="sujetos", y="Peso Muestra", title="Interpolación 2, inciso a)")+
theme_bw()
ggplotly(graf_2)
######################################
# FORMA 2 - QUANTIL 5
#####################################
muestra5<-as.numeric(unlist(dplyr::select(dplyr::filter(pcwstd, subclass == 5,),"zscore")))
sujetos5 <- c(1:length(muestra5))
sujetos_seq5 <- seq(from=1, to=8, by=0.1)
pol_muestra5 <- as.function(poly.calc(sujetos5, muestra5))
muestra_seq5 <- pol_muestra5(sujetos_seq5)
poly.calc(sujetos5, muestra5)
-4.94969 + 13.71929*x - 12.46775*x^2 + 5.722334*x^3 - 1.45807*x^4 + 0.2089239*x^5 - 0.01574029*x^6 +
0.0004847141*x^7
graf_2 <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+
geom_hline(yintercept = 0, linetype="dashed")+
#Muestra 1
geom_line(aes(x=sujetos_seq5, y=muestra_seq5), color="green", size=1)+
geom_point(aes(x=sujetos5, y=muestra5), color="dodgerblue3", size=3)+
labs(x="sujetos", y="Peso Muestra", title="Interpolación 2, inciso a)")+
theme_bw()
ggplotly(graf_2)
poly.calc(sujetos, muestra1)
-6.122264 + 17.67111*x - 18.56562*x^2 + 10.44433*x^3 - 3.536183*x^4 + 0.7576271*x^5 - 0.1036324*x^6 +
0.008774759*x^7 - 0.000418757*x^8 + 8.6019e-06*x^9
poly.calc(sujetos, muestra1)
-6.122264 + 17.67111*x - 18.56562*x^2 + 10.44433*x^3 - 3.536183*x^4 + 0.7576271*x^5 - 0.1036324*x^6 +
0.008774759*x^7 - 0.000418757*x^8 + 8.6019e-06*x^9
poly.calc(sujetos2, muestra2)
-0.2197296 + 2.0046*x - 1.811326*x^2 + 0.8375173*x^3 - 0.2182443*x^4 + 0.03246031*x^5 - 0.002569767*x^6 +
8.38559e-05*x^7
poly.calc(sujetos3, muestra3)
4.793893 - 11.81498*x + 14.1384*x^2 - 9.532235*x^3 + 4.068752*x^4 - 1.159912*x^5 + 0.2257844*x^6 -
0.03004852*x^7 + 0.002683565*x^8 - 0.0001534813*x^9 + 5.071574e-06*x^10 - 7.35409e-08*x^11
poly.calc(sujetos4, muestra4)
2.512275 - 4.393058*x + 4.022133*x^2 - 1.838199*x^3 + 0.4632213*x^4 - 0.06537888*x^5 + 0.004842031*x^6 -
0.0001464992*x^7
poly.calc(sujetos5, muestra5)
-4.94969 + 13.71929*x - 12.46775*x^2 + 5.722334*x^3 - 1.45807*x^4 + 0.2089239*x^5 - 0.01574029*x^6 +
0.0004847141*x^7
deri_pol1 <- function(x){-6.122264 + 17.67111*x - 18.56562*x^2 + 10.44433*x^3 - 3.536183*x^4 + 0.7576271*x^5 - 0.1036324*x^6 + 0.008774759*x^7 - 0.000418757*x^8 + 8.6019e-06*x^9}
deri_pol2 <- function(x){-0.2197296 + 2.0046*x - 1.811326*x^2 + 0.8375173*x^3 - 0.2182443*x^4 + 0.03246031*x^5 - 0.002569767*x^6 + 8.38559e-05*x^7}
deri_pol3 <- function(x){4.793893 - 11.81498*x + 14.1384*x^2 - 9.532235*x^3 + 4.068752*x^4 - 1.159912*x^5 + 0.2257844*x^6 - 0.03004852*x^7 + 0.002683565*x^8 - 0.0001534813*x^9 + 5.071574e-06*x^10 - 7.35409e-08*x^11 }
deri_pol4 <- function(x){2.512275 - 4.393058*x + 4.022133*x^2 - 1.838199*x^3 + 0.4632213*x^4 - 0.06537888*x^5 + 0.004842031*x^6 - 0.0001464992*x^7}
deri_pol5 <- function(x){-4.94969 + 13.71929*x - 12.46775*x^2 + 5.722334*x^3 - 1.45807*x^4 + 0.2089239*x^5 - 0.01574029*x^6 + 0.0004847141*x^7}
##################### GRAFICAMOS UNO DE ELLOS ###########
x1 <- seq(from=1, to=10, by=0.1)
y1 <- deri_pol1(sujetos_seq)
graf_muestra_1 <- ggplot()+
#Ejes
geom_vline(xintercept = 0, linetype="dashed")+
geom_hline(yintercept = 0, linetype="dashed")+
#Pendiente
geom_line(aes(x1, y1), color="dodgerblue3", size=1)+
labs(x="dias", y="Peso Muestra", title="Pendiente de la muestra 1")+
theme_bw()
ggplotly(graf_muestra_1)

summary(reg)
Call:
glm(formula = form, family = binomial, data = pcwstd)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.683 2.709 -0.990 0.322
lambda 5.160 4.108 1.256 0.209
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 58.086 on 45 degrees of freedom
Residual deviance: 56.425 on 44 degrees of freedom
AIC: 60.425
Number of Fisher Scoring iterations: 4
############# Prueba de obtener los valores de cada nudo ###
bsx <- data.frame(bs(x=pcwstd$zscore , knots=1:3/5))
bsx
####################
x <- seq(from = 0, to = 6, by = .025)
y <- sin(2*x) + x -.1*x^2 + 2 + rnorm(length(x), sd = .3)
generate_design_matrix <- function(x, knot_vector, degree){
return(cbind(outer(x,1:degree,"^"),outer(x,knot_vector,">")*outer(x,knot_vector,"-")^degree))
}
design_matrix2 <- generate_design_matrix(degree = 1, knot_vector = c(1,2.5,4, 5.7), x = x)
design_matrix2
mod_ls2 <- lm(y~design_matrix2)
mod_ls2
design_matrix3 <- generate_design_matrix(degree = 1, knot_vector = seq(from = 0.1, to = 5.9, by = .2), x = x)
mod_ls3 <- lm(y~design_matrix3)
yhatbad <- predict(mod_ls3)
ggplot() +
geom_point(aes(x = x, y = y), color = "black", alpha = .5) +
geom_line(aes(x = x, y = predict(mod_ls2)), color = "red") +
geom_line(aes(x = x, y = yhatbad), color = "blue") +
labs(title = "Piecewise linear spline - Good number vs. too many knots...")
X <- cbind(1, generate_design_matrix(degree = 3, knot_vector = c(2), x = x))
betas <- solve(t(X) %*% X) %*% t(X) %*% y
yhat <- X %*% betas
ggplot() +
geom_point(aes(x = x, y = y), color = "black", alpha = .3) +
geom_line(aes(x = x, y = yhat), color = "black", alpha = 1) +
geom_vline(aes(xintercept = 2), color = "black", linetype = "dotdash") +
labs(title = "Cubic spline",
subtitle = "1 knot at x=2, no penalization, underfitting")

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIyBCdXNjYW5kbyBsYSBmdW5jacOzbiBDb25zdGFudGUgcG9yIHBhcnRlcw0KDQpMYSBpZGVhIGVzIGVuY29udHJhciB1bmEgZnVuY2nDs24gY29uc3RhbnRlIHBvciBwYXJ0ZXMgZG9uZGU6DQoNCi0gICBMYSBkaXZpc2nDs24gc2VhbiBrbm90cw0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KHBvbHlub20pDQpsaWJyYXJ5KHNwbGluZXMpDQpsaWJyYXJ5KHBsb3RseSkNCmBgYA0KDQpgYGB7cn0NCnNldHdkKCJDOi9oY2dhbHZhbi9SZXBvc2l0b3Jpb3MvaGNnYWx2YW5fcHJvamVjdC9kYXRhL3VuaW9uL0VuZCIpDQp0ZW1wID0gZ3N1YigiLip0YXJnZXQuKiIsICIiLCByZWFkTGluZXMoImRiY2FzZXNwaWVjZXN3aWNlLmNzdiIpKQ0KZGF0YTwtcmVhZC50YWJsZSh0ZXh0PXRlbXAsIHNlcD0iLCIsIGhlYWRlcj1UUlVFKQ0KZHo8LWRhdGEuZnJhbWUoZGF0YVssYygiRCIsIkEiLCJ6c2NvcmUiLCJzdWJjbGFzcyIpXSkNCnBjd3N0ZDwtZGF0YS5mcmFtZShkeikNCnBjd3N0ZA0KDQpgYGANCg0KYGBge3J9DQojIyMjIyMjIyMjI1Bvc2libGUgRk9STUEgMSBDdWFuZG8gYnVzY2Ftb3MgYWxndW5hIGRpdmlzacOzbiBtw6FzIGRlIGtub3RzIyMjIyMjIyMjIyMNCmg8LWFzLm51bWVyaWModW5saXN0KHBjd3N0ZCR6c2NvcmUpKQ0KbG1heCA8LSBoW2MoMSwgd2hpY2goZGlmZihzaWduKGRpZmYoaCkpKT09LTIpKzEsIGxlbmd0aChoKSldDQpvcmRlcihoLCBkZWNyZWFzaW5nID0gRkFMU0UpDQpkYXRhb3JkIDwtIGhbb3JkZXIoaCwgZGVjcmVhc2luZyA9IEZBTFNFKV0NCiNwbG90KGRhdGFvcmQpDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjDQpzcGxpbmVLbm90cy5kZWZhdWx0IDwtIGZ1bmN0aW9uKG9iamVjdCkgYXR0cihvYmplY3QsICJrbm90cyIpDQpzcGxpbmVLbm90cyhicyhkYXRhb3JkLGRlZ3JlZT0xLCBkZiA9IDUpKQ0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KYGBgDQoNCjxodHRwczovL3JzdHVkaW8tcHVicy1zdGF0aWMuczMuYW1hem9uYXdzLmNvbS84ODg4ODFfMzJjMGExNGRhMWU0NDBlN2FkOWI2ZjE4OTNmYzI2ZmQuaHRtbD4NCg0KPGh0dHBzOi8vam9zaHVhLW51Z2VudC5naXRodWIuaW8vc3BsaW5lcy8+DQoNCmBgYHtyfQ0KDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KIyBGT1JNQSAyICAtIFFVQU5USUwgMQ0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KbXVlc3RyYTE8LWFzLm51bWVyaWModW5saXN0KGRwbHlyOjpzZWxlY3QoZHBseXI6OmZpbHRlcihwY3dzdGQsIHN1YmNsYXNzID09IDEsKSwienNjb3JlIikpKQ0KcG9seS5jYWxjKHN1amV0b3MsIG11ZXN0cmExKQ0Kc3VqZXRvcyA8LSBjKDE6bGVuZ3RoKG11ZXN0cmExKSkNCnN1amV0b3Nfc2VxIDwtIHNlcShmcm9tPTEsIHRvPTEwLCBieT0wLjEpDQoNCnBvbF9tdWVzdHJhMSA8LSBhcy5mdW5jdGlvbihwb2x5LmNhbGMoc3VqZXRvcywgbXVlc3RyYTEpKQ0KbXVlc3RyYV9zZXEgPC0gcG9sX211ZXN0cmExKHN1amV0b3Nfc2VxKQ0KDQpncmFmXzIgPC0gZ2dwbG90KCkrDQogIGdlb21fdmxpbmUoeGludGVyY2VwdCA9IDAsIGxpbmV0eXBlPSJkYXNoZWQiKSsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0ID0gMCwgbGluZXR5cGU9ImRhc2hlZCIpKw0KICAjTXVlc3RyYSAxDQogIGdlb21fbGluZShhZXMoeD1zdWpldG9zX3NlcSwgeT1tdWVzdHJhX3NlcSksIGNvbG9yPSJncmVlbiIsIHNpemU9MSkrDQogIGdlb21fcG9pbnQoYWVzKHg9c3VqZXRvcywgeT1tdWVzdHJhMSksIGNvbG9yPSJkb2RnZXJibHVlMyIsIHNpemU9MykrDQoNCiAgbGFicyh4PSJzdWpldG9zIiwgeT0iUGVzbyBNdWVzdHJhIiwgdGl0bGU9IkludGVycG9sYWNpw7NuICAyLCBpbmNpc28gYSkiKSsNCiAgdGhlbWVfYncoKQ0KDQpnZ3Bsb3RseShncmFmXzIpDQoNCiMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjDQojIEZPUk1BIDIgIC0gUVVBTlRJTCAyDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjDQptdWVzdHJhMjwtYXMubnVtZXJpYyh1bmxpc3QoZHBseXI6OnNlbGVjdChkcGx5cjo6ZmlsdGVyKHBjd3N0ZCwgc3ViY2xhc3MgPT0gMiwpLCJ6c2NvcmUiKSkpDQoNCnN1amV0b3MyIDwtIGMoMTpsZW5ndGgobXVlc3RyYTIpKQ0Kc3VqZXRvc19zZXEyIDwtIHNlcShmcm9tPTEsIHRvPTEwLCBieT0wLjEpDQoNCnBvbF9tdWVzdHJhMiA8LSBhcy5mdW5jdGlvbihwb2x5LmNhbGMoc3VqZXRvczIsIG11ZXN0cmEyKSkNCm11ZXN0cmFfc2VxMiA8LSBwb2xfbXVlc3RyYTIoc3VqZXRvc19zZXEyKQ0KcG9seS5jYWxjKHN1amV0b3MyLCBtdWVzdHJhMikNCg0KZ3JhZl8yIDwtIGdncGxvdCgpKw0KICBnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZT0iZGFzaGVkIikrDQogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGxpbmV0eXBlPSJkYXNoZWQiKSsNCiAgI011ZXN0cmEgMQ0KICBnZW9tX2xpbmUoYWVzKHg9c3VqZXRvc19zZXEyLCB5PW11ZXN0cmFfc2VxMiksIGNvbG9yPSJncmVlbiIsIHNpemU9MSkrDQogIGdlb21fcG9pbnQoYWVzKHg9c3VqZXRvczIsIHk9bXVlc3RyYTIpLCBjb2xvcj0iZG9kZ2VyYmx1ZTMiLCBzaXplPTMpKw0KDQogIGxhYnMoeD0ic3VqZXRvcyIsIHk9IlBlc28gTXVlc3RyYSIsIHRpdGxlPSJJbnRlcnBvbGFjacOzbiAgMiwgaW5jaXNvIGEpIikrDQogIHRoZW1lX2J3KCkNCg0KZ2dwbG90bHkoZ3JhZl8yKQ0KDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KIyBGT1JNQSAyICAtIFFVQU5USUwgMw0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KbXVlc3RyYTM8LWFzLm51bWVyaWModW5saXN0KGRwbHlyOjpzZWxlY3QoZHBseXI6OmZpbHRlcihwY3dzdGQsIHN1YmNsYXNzID09IDMsKSwienNjb3JlIikpKQ0KDQpzdWpldG9zMyA8LSBjKDE6bGVuZ3RoKG11ZXN0cmEzKSkNCnN1amV0b3Nfc2VxMyA8LSBzZXEoZnJvbT0xLCB0bz0xMiwgYnk9MC4xKQ0KDQpwb2xfbXVlc3RyYTMgPC0gYXMuZnVuY3Rpb24ocG9seS5jYWxjKHN1amV0b3MzLCBtdWVzdHJhMykpDQptdWVzdHJhX3NlcTMgPC0gcG9sX211ZXN0cmEzKHN1amV0b3Nfc2VxMykNCnBvbHkuY2FsYyhzdWpldG9zMywgbXVlc3RyYTMpDQoNCmdyYWZfMiA8LSBnZ3Bsb3QoKSsNCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgbGluZXR5cGU9ImRhc2hlZCIpKw0KICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZT0iZGFzaGVkIikrDQogICNNdWVzdHJhIDENCiAgZ2VvbV9saW5lKGFlcyh4PXN1amV0b3Nfc2VxMywgeT1tdWVzdHJhX3NlcTMpLCBjb2xvcj0iZ3JlZW4iLCBzaXplPTEpKw0KICBnZW9tX3BvaW50KGFlcyh4PXN1amV0b3MzLCB5PW11ZXN0cmEzKSwgY29sb3I9ImRvZGdlcmJsdWUzIiwgc2l6ZT0zKSsNCg0KICBsYWJzKHg9InN1amV0b3MiLCB5PSJQZXNvIE11ZXN0cmEiLCB0aXRsZT0iSW50ZXJwb2xhY2nDs24gIDIsIGluY2lzbyBhKSIpKw0KICB0aGVtZV9idygpDQoNCmdncGxvdGx5KGdyYWZfMikNCg0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMNCiMgRk9STUEgMiAgLSBRVUFOVElMIDQNCiMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMNCm11ZXN0cmE0PC1hcy5udW1lcmljKHVubGlzdChkcGx5cjo6c2VsZWN0KGRwbHlyOjpmaWx0ZXIocGN3c3RkLCBzdWJjbGFzcyA9PSA0LCksInpzY29yZSIpKSkNCg0Kc3VqZXRvczQgPC0gYygxOmxlbmd0aChtdWVzdHJhNCkpDQpzdWpldG9zX3NlcTQgPC0gc2VxKGZyb209MSwgdG89OCwgYnk9MC4xKQ0KDQpwb2xfbXVlc3RyYTQgPC0gYXMuZnVuY3Rpb24ocG9seS5jYWxjKHN1amV0b3M0LCBtdWVzdHJhNCkpDQptdWVzdHJhX3NlcTQgPC0gcG9sX211ZXN0cmE0KHN1amV0b3Nfc2VxNCkNCnBvbHkuY2FsYyhzdWpldG9zNCwgbXVlc3RyYTQpDQoNCmdyYWZfMiA8LSBnZ3Bsb3QoKSsNCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgbGluZXR5cGU9ImRhc2hlZCIpKw0KICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZT0iZGFzaGVkIikrDQogICNNdWVzdHJhIDENCiAgZ2VvbV9saW5lKGFlcyh4PXN1amV0b3Nfc2VxNCwgeT1tdWVzdHJhX3NlcTQpLCBjb2xvcj0iZ3JlZW4iLCBzaXplPTEpKw0KICBnZW9tX3BvaW50KGFlcyh4PXN1amV0b3M0LCB5PW11ZXN0cmE0KSwgY29sb3I9ImRvZGdlcmJsdWUzIiwgc2l6ZT0zKSsNCg0KICBsYWJzKHg9InN1amV0b3MiLCB5PSJQZXNvIE11ZXN0cmEiLCB0aXRsZT0iSW50ZXJwb2xhY2nDs24gIDIsIGluY2lzbyBhKSIpKw0KICB0aGVtZV9idygpDQoNCmdncGxvdGx5KGdyYWZfMikNCg0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMNCiMgRk9STUEgMiAgLSBRVUFOVElMIDUNCiMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMNCm11ZXN0cmE1PC1hcy5udW1lcmljKHVubGlzdChkcGx5cjo6c2VsZWN0KGRwbHlyOjpmaWx0ZXIocGN3c3RkLCBzdWJjbGFzcyA9PSA1LCksInpzY29yZSIpKSkNCg0Kc3VqZXRvczUgPC0gYygxOmxlbmd0aChtdWVzdHJhNSkpDQpzdWpldG9zX3NlcTUgPC0gc2VxKGZyb209MSwgdG89OCwgYnk9MC4xKQ0KDQpwb2xfbXVlc3RyYTUgPC0gYXMuZnVuY3Rpb24ocG9seS5jYWxjKHN1amV0b3M1LCBtdWVzdHJhNSkpDQptdWVzdHJhX3NlcTUgPC0gcG9sX211ZXN0cmE1KHN1amV0b3Nfc2VxNSkNCnBvbHkuY2FsYyhzdWpldG9zNSwgbXVlc3RyYTUpDQoNCmdyYWZfMiA8LSBnZ3Bsb3QoKSsNCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgbGluZXR5cGU9ImRhc2hlZCIpKw0KICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZT0iZGFzaGVkIikrDQogICNNdWVzdHJhIDENCiAgZ2VvbV9saW5lKGFlcyh4PXN1amV0b3Nfc2VxNSwgeT1tdWVzdHJhX3NlcTUpLCBjb2xvcj0iZ3JlZW4iLCBzaXplPTEpKw0KICBnZW9tX3BvaW50KGFlcyh4PXN1amV0b3M1LCB5PW11ZXN0cmE1KSwgY29sb3I9ImRvZGdlcmJsdWUzIiwgc2l6ZT0zKSsNCg0KICBsYWJzKHg9InN1amV0b3MiLCB5PSJQZXNvIE11ZXN0cmEiLCB0aXRsZT0iSW50ZXJwb2xhY2nDs24gIDIsIGluY2lzbyBhKSIpKw0KICB0aGVtZV9idygpDQoNCmdncGxvdGx5KGdyYWZfMikNCg0KcG9seS5jYWxjKHN1amV0b3MsIG11ZXN0cmExKQ0KYGBgDQoNCmBgYHtyfQ0KIyMjICMgRGVyaXZhciBlbCBwb2xpbm9taW8gaW50ZXJwb2xhbnRlIHBhcmEgb2J0ZW5lciBsYSBlY3VhY2nDs24gcXVlIGRlc2NyaWJlIHN1IHBlbmRpZW50ZSB5IGdyYWZpY2FybGENCnBvbHkuY2FsYyhzdWpldG9zLCBtdWVzdHJhMSkNCnBvbHkuY2FsYyhzdWpldG9zMiwgbXVlc3RyYTIpDQpwb2x5LmNhbGMoc3VqZXRvczMsIG11ZXN0cmEzKQ0KcG9seS5jYWxjKHN1amV0b3M0LCBtdWVzdHJhNCkNCnBvbHkuY2FsYyhzdWpldG9zNSwgbXVlc3RyYTUpDQpgYGANCg0KYGBge3J9DQoNCg0KZGVyaV9wb2wxIDwtIGZ1bmN0aW9uKHgpey02LjEyMjI2NCArIDE3LjY3MTExKnggLSAxOC41NjU2Mip4XjIgKyAxMC40NDQzMyp4XjMgLSAzLjUzNjE4Myp4XjQgKyAwLjc1NzYyNzEqeF41IC0gMC4xMDM2MzI0KnheNiArIDAuMDA4Nzc0NzU5KnheNyAtIDAuMDAwNDE4NzU3KnheOCArIDguNjAxOWUtMDYqeF45fQ0KDQpkZXJpX3BvbDIgPC0gZnVuY3Rpb24oeCl7LTAuMjE5NzI5NiArIDIuMDA0Nip4IC0gMS44MTEzMjYqeF4yICsgMC44Mzc1MTczKnheMyAtIDAuMjE4MjQ0Myp4XjQgKyAwLjAzMjQ2MDMxKnheNSAtIDAuMDAyNTY5NzY3KnheNiArIDguMzg1NTllLTA1KnheN30NCg0KZGVyaV9wb2wzIDwtIGZ1bmN0aW9uKHgpezQuNzkzODkzIC0gMTEuODE0OTgqeCArIDE0LjEzODQqeF4yIC0gOS41MzIyMzUqeF4zICsgNC4wNjg3NTIqeF40IC0gMS4xNTk5MTIqeF41ICsgMC4yMjU3ODQ0KnheNiAtICAwLjAzMDA0ODUyKnheNyArIDAuMDAyNjgzNTY1KnheOCAtIDAuMDAwMTUzNDgxMyp4XjkgKyA1LjA3MTU3NGUtMDYqeF4xMCAtIDcuMzU0MDllLTA4KnheMTEgfQ0KDQpkZXJpX3BvbDQgPC0gZnVuY3Rpb24oeCl7Mi41MTIyNzUgLSA0LjM5MzA1OCp4ICsgNC4wMjIxMzMqeF4yIC0gMS44MzgxOTkqeF4zICsgMC40NjMyMjEzKnheNCAtIDAuMDY1Mzc4ODgqeF41ICsgMC4wMDQ4NDIwMzEqeF42IC0gMC4wMDAxNDY0OTkyKnheN30NCg0KZGVyaV9wb2w1IDwtIGZ1bmN0aW9uKHgpey00Ljk0OTY5ICsgMTMuNzE5MjkqeCAtIDEyLjQ2Nzc1KnheMiArIDUuNzIyMzM0KnheMyAtIDEuNDU4MDcqeF40ICsgMC4yMDg5MjM5KnheNSAtIDAuMDE1NzQwMjkqeF42ICsgMC4wMDA0ODQ3MTQxKnheN30NCg0KDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMgR1JBRklDQU1PUyBVTk8gREUgRUxMT1MgIyMjIyMjIyMjIyMNCngxIDwtIHNlcShmcm9tPTEsIHRvPTEwLCBieT0wLjEpDQp5MSA8LSBkZXJpX3BvbDEoc3VqZXRvc19zZXEpDQoNCmdyYWZfbXVlc3RyYV8xIDwtIGdncGxvdCgpKw0KICAjRWplcw0KICBnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSAwLCBsaW5ldHlwZT0iZGFzaGVkIikrDQogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGxpbmV0eXBlPSJkYXNoZWQiKSsNCiAgI1BlbmRpZW50ZQ0KICAgIGdlb21fbGluZShhZXMoeDEsIHkxKSwgY29sb3I9ImRvZGdlcmJsdWUzIiwgc2l6ZT0xKSsNCiAgICBsYWJzKHg9ImRpYXMiLCB5PSJQZXNvIE11ZXN0cmEiLCB0aXRsZT0iUGVuZGllbnRlIGRlIGxhIG11ZXN0cmEgMSIpKw0KICB0aGVtZV9idygpDQpnZ3Bsb3RseShncmFmX211ZXN0cmFfMSkNCmBgYA0KDQpgYGB7cn0NCiMjIyBPYnRlbmdvIGxvcyBsw61taXRlcyBkZSB6c2NvcmUgYSBwYXJ0aXIgZGVsIGZpbHRybyBzdWJjbGFzZSB5IHV0aWxpemFyIGVuIGxhIGZ1bmNpw7NuIHBvciBwYXJ0ZXMNCg0KbGltMSA8LSBtYXgoYXMubnVtZXJpYyh1bmxpc3QoZHBseXI6OnNlbGVjdChkcGx5cjo6ZmlsdGVyKHBjd3N0ZCwgc3ViY2xhc3MgPT0gMSwpLCJ6c2NvcmUiKSkpKQ0KbGltMiA8LSBtYXgoYXMubnVtZXJpYyh1bmxpc3QoZHBseXI6OnNlbGVjdChkcGx5cjo6ZmlsdGVyKHBjd3N0ZCwgc3ViY2xhc3MgPT0gMiwpLCJ6c2NvcmUiKSkpKQ0KbGltMyA8LSBtYXgoYXMubnVtZXJpYyh1bmxpc3QoZHBseXI6OnNlbGVjdChkcGx5cjo6ZmlsdGVyKHBjd3N0ZCwgc3ViY2xhc3MgPT0gMywpLCJ6c2NvcmUiKSkpKQ0KbGltNCA8LSBtYXgoYXMubnVtZXJpYyh1bmxpc3QoZHBseXI6OnNlbGVjdChkcGx5cjo6ZmlsdGVyKHBjd3N0ZCwgc3ViY2xhc3MgPT0gNCwpLCJ6c2NvcmUiKSkpKQ0KbGltNSA8LSBtYXgoYXMubnVtZXJpYyh1bmxpc3QoZHBseXI6OnNlbGVjdChkcGx5cjo6ZmlsdGVyKHBjd3N0ZCwgc3ViY2xhc3MgPT0gNSwpLCJ6c2NvcmUiKSkpKQ0KDQoNCnN1amV0b3MxIDwtIGMoMTpsZW5ndGgobXVlc3RyYTEpKQ0Kc3VqZXRvczIgPC0gYygxOmxlbmd0aChtdWVzdHJhMikpDQpzdWpldG9zMyA8LSBjKDE6bGVuZ3RoKG11ZXN0cmEzKSkNCnN1amV0b3M0IDwtIGMoMTpsZW5ndGgobXVlc3RyYTQpKQ0Kc3VqZXRvczUgPC0gYygxOmxlbmd0aChtdWVzdHJhNSkpDQoNCnBvc2ljaW9uYXggPC0gZnVuY3Rpb24oeCwgcG9zKXsNCiAgdiA8LSBOVUxMDQogIGggPC0gTlVMTA0KICBoPC1hcy5udW1lcmljKHVubGlzdChkcGx5cjo6c2VsZWN0KGRwbHlyOjpmaWx0ZXIocGN3c3RkLCBzdWJjbGFzcyA9PSBwb3MsKSwienNjb3JlIikpKQ0KICBkaXYuMSA8LSByb3VuZCgoaFtvcmRlcihoLCBkZWNyZWFzaW5nID0gRkFMU0UpXSAvIHgpLDQpDQogIHY8LSB3aGljaChkaXYuMSA9PSAxLjAwMDAsKQ0KICB2DQp9ICANCiAgDQpidXNjYXJ4IDwtIGZ1bmN0aW9uKHgpew0KICAgIGQgPC0gTlVMTA0KICAgIGlmZWxzZSAoeCA+IDAgJiB4PD0gbGltMSwgZCA8LSBwb3NpY2lvbmF4KHgsIDEpLCAwKQ0KICAgIGlmZWxzZSAoeD5saW0xICYgeDw9bGltMiwgZCA8LSBwb3NpY2lvbmF4KHgsIDIpLCAwKQ0KICAgIGlmZWxzZSAoeD5saW0yICYgeDw9bGltMywgZCA8LSBwb3NpY2lvbmF4KHgsIDMpLCAwKQ0KICAgIGlmZWxzZSAoeD5saW0zICYgeDw9bGltNCwgZCA8LSBwb3NpY2lvbmF4KHgsIDQpLCAwKQ0KICAgIGlmZWxzZSAoeD5saW00LCBkIDwtIHBvc2ljaW9uYXgoeCwgNSksIDApDQogICAgZA0KfQ0KDQpmeCA8LSBmdW5jdGlvbih4LCBkYXQpew0KICAgIGYgPC0gTlVMTA0KICAgIGlmZWxzZSAoeCA+IDAgJiB4PD0gbGltMSwgZiA8LSBkZXJpX3BvbDEoZGF0KSwgMCkNCiAgICBpZmVsc2UgKHg+bGltMSAmIHg8PWxpbTIsIGYgPC0gZGVyaV9wb2wyKGRhdCksIDApDQogICAgaWZlbHNlICh4PmxpbTIgJiB4PD1saW0zLCBmIDwtIGRlcmlfcG9sMyhkYXQpLCAwKQ0KICAgIGlmZWxzZSAoeD5saW0zICYgeDw9bGltNCwgZiA8LSBkZXJpX3BvbDQoZGF0KSwgMCkNCiAgICBpZmVsc2UgKHg+bGltNCwgZiA8LSBkZXJpX3BvbDUoZGF0KSwgMCkNCiAgICBmDQp9DQoNCnggPC0gZGF0YS5mcmFtZShwY3dzdGQkenNjb3JlKQ0KZm9yKGkgaW4gMTpucm93KHgpKSB7ICAgICAgICMgZm9yLWxvb3Agb3ZlciByb3dzDQogIGRhdCA8LSBidXNjYXJ4KHBjd3N0ZCR6c2NvcmVbW2ldXSkNCiAgI3ByaW50KGRhdCkNCiAgI3ByaW50KGZ4KHBjd3N0ZCR6c2NvcmVbW2ldXSwgZGF0KSkNCiAgbGFtYmQgPC1meChwY3dzdGQkenNjb3JlW1tpXV0sIGRhdCkNCiAgcGN3c3RkJGxhbWJkYVtpXSA8LSBsYW1iZA0KICB9DQoNCnBjd3N0ZA0KDQpwbG90KHBjd3N0ZCRsYW1iZGEsIHR5cGU9ImwiLCBsYXM9MSkNCnBvaW50cyh4KQ0KDQpgYGANCg0KYGBge3J9DQpmb3JtID0gIkEgfiBsYW1iZGEiDQpmb3JtID0gZm9ybXVsYShmb3JtKQ0KcmVnID0gZ2xtKGZvcm0sZGF0YT1wY3dzdGQsZmFtaWx5PWJpbm9taWFsKQ0Kc3VtbWFyeShyZWcpDQoNCmBgYA0KDQpgYGB7cn0NCmxpYnJhcnkoc3Vydml2YWwpDQojUmVncmVzaW9uIGxvZ8Otc3RpY2EgY29uZGljaW9uYWwgbyBwb3IgZXN0cmF0b3MNCnBjd3N0ZA0KcmVnbG9nLmNvbmQgPC1jbG9naXQoQX5BbGFtYmRhLGRhdGE9cGN3c3RkKQ0KDQpzdW1tYXJ5KHJlZ2xvZy5jb25kKQ0KZGVsdGEgPSBjb2VmZmljaWVudHMocmVnbG9nLmNvbmQpW1sxXV0NCmBgYA0KDQpgYGB7cn0NCiMjIyMjIyMjIyMjIyMgUHJ1ZWJhIGRlIG9idGVuZXIgbG9zIHZhbG9yZXMgZGUgY2FkYSBudWRvICMjIw0KYnN4IDwtIGRhdGEuZnJhbWUoYnMoeD1wY3dzdGQkenNjb3JlICwga25vdHM9MTozLzUpKQ0KYnN4DQoNCiMjIyMjIyMjIyMjIyMjIyMjIyMjDQp4IDwtIHNlcShmcm9tID0gMCwgdG8gPSA2LCBieSA9IC4wMjUpDQp5IDwtIHNpbigyKngpICsgeCAtLjEqeF4yICsgMiArIHJub3JtKGxlbmd0aCh4KSwgc2QgPSAuMykNCg0KZ2VuZXJhdGVfZGVzaWduX21hdHJpeCA8LSBmdW5jdGlvbih4LCBrbm90X3ZlY3RvciwgZGVncmVlKXsNCiAgcmV0dXJuKGNiaW5kKG91dGVyKHgsMTpkZWdyZWUsIl4iKSxvdXRlcih4LGtub3RfdmVjdG9yLCI+Iikqb3V0ZXIoeCxrbm90X3ZlY3RvciwiLSIpXmRlZ3JlZSkpDQp9DQoNCmRlc2lnbl9tYXRyaXgyIDwtIGdlbmVyYXRlX2Rlc2lnbl9tYXRyaXgoZGVncmVlID0gMSwga25vdF92ZWN0b3IgPSBjKDEsMi41LDQsIDUuNyksIHggPSB4KQ0KZGVzaWduX21hdHJpeDINCm1vZF9sczIgPC0gbG0oeX5kZXNpZ25fbWF0cml4MikNCm1vZF9sczINCmRlc2lnbl9tYXRyaXgzIDwtIGdlbmVyYXRlX2Rlc2lnbl9tYXRyaXgoZGVncmVlID0gMSwga25vdF92ZWN0b3IgPSBzZXEoZnJvbSA9IDAuMSwgdG8gPSA1LjksIGJ5ID0gLjIpLCB4ID0geCkNCm1vZF9sczMgPC0gbG0oeX5kZXNpZ25fbWF0cml4MykNCnloYXRiYWQgPC0gcHJlZGljdChtb2RfbHMzKQ0KZ2dwbG90KCkgKw0KICBnZW9tX3BvaW50KGFlcyh4ID0geCwgeSA9IHkpLCBjb2xvciA9ICJibGFjayIsIGFscGhhID0gLjUpICsNCiAgZ2VvbV9saW5lKGFlcyh4ID0geCwgeSA9IHByZWRpY3QobW9kX2xzMikpLCBjb2xvciA9ICJyZWQiKSArDQogIGdlb21fbGluZShhZXMoeCA9IHgsIHkgPSB5aGF0YmFkKSwgY29sb3IgPSAiYmx1ZSIpICsNCiAgbGFicyh0aXRsZSA9ICJQaWVjZXdpc2UgbGluZWFyIHNwbGluZSAtIEdvb2QgbnVtYmVyIHZzLiB0b28gbWFueSBrbm90cy4uLiIpDQoNCmBgYA0KDQpgYGB7cn0NClggPC0gY2JpbmQoMSwgZ2VuZXJhdGVfZGVzaWduX21hdHJpeChkZWdyZWUgPSAzLCBrbm90X3ZlY3RvciA9IGMoMiksIHggPSB4KSkNCmJldGFzIDwtIHNvbHZlKHQoWCkgJSolIFgpICUqJSB0KFgpICUqJSB5DQp5aGF0IDwtIFggJSolIGJldGFzDQpnZ3Bsb3QoKSArDQogIGdlb21fcG9pbnQoYWVzKHggPSB4LCB5ID0geSksIGNvbG9yID0gImJsYWNrIiwgYWxwaGEgPSAuMykgKw0KICBnZW9tX2xpbmUoYWVzKHggPSB4LCB5ID0geWhhdCksIGNvbG9yID0gImJsYWNrIiwgYWxwaGEgPSAxKSArDQogIGdlb21fdmxpbmUoYWVzKHhpbnRlcmNlcHQgPSAyKSwgY29sb3IgPSAiYmxhY2siLCBsaW5ldHlwZSA9ICJkb3RkYXNoIikgKw0KICBsYWJzKHRpdGxlID0gIkN1YmljIHNwbGluZSIsDQogICAgICAgc3VidGl0bGUgPSAiMSBrbm90IGF0IHg9Miwgbm8gcGVuYWxpemF0aW9uLCB1bmRlcmZpdHRpbmciKQ0KYGBgDQo=